The Programmer Disk/The Programmer Disk (Microforum).iso/xpro/qb1/pro2/lineedit.bas

BASIC Source File | 1992-03-21 | 18KB | 417 lines

DEFINT A-Z
'+==================================================================+
'|                           LINEEDIT.BAS                           |
'|                                                                  |
'|  A line edit routine developed by Larry Stone and the SWOCC      |
'|  students of Larry Stone, CS133B, Fall Term '91, SWOCC.          |
'|                                                                  |
'|  Purpose:  Line editor that can edit a string in a virtual       |
'|            window, VwindowSize%, bigger than the allowable       |
'|            display length, DisplayLen%                           |
'|                                                                  |
'|  Modules:  LINEEDIT                                              |
'|            KEYBOARD                                              |
'|                                                                  |
'|  Call:     LineEdit Row%, Col%, CurPos%, A$, VwindowSize%, _     |
'|                     DisplayLen%, CuroffSet%, Kee%, Separaters$,_ |
'|                     Terminators()                                |
'+------------------------------------------------------------------+
'
'+==================================================================+
'|                           DECLARATIONS                           |
'+------------------------------------------------------------------+
'
DECLARE FUNCTION InsertState% ()
DECLARE FUNCTION KeyPressed% ()
DECLARE FUNCTION Lower% (Value%)
DECLARE SUB RingSound ()
DECLARE FUNCTION Upper% (Value%)

CONST False = 0, True = NOT False

'+==================================================================+
'|                            SUBPROGRAMS                           |
'+------------------------------------------------------------------+

'+======================================================================+
'|                           LIneEdit Subprogram                        |
'|                                                                      |
'|  Developed by: Larry Stone & his students during Fall & Winter term, |
'|                1991-1992, Southwestern Oregon Community College.     |
'|                                                                      |
'|  Purpose:  Line editor that can scroll/edit a virtual window longer  |
'|            than the displayable line.                                |
'|                                                                      |
'|  Input:  Row%            The Row to display the edit string.         |
'|          Col%            The starting column for the edit string.    |
'|          VwindowSize%    The length of optional virtual window.      |
'|                          If VwindowSize is less than DisplayLen then |
'|                          it is automatically sized to DisplayLen.    |
'|          DisplayLen%     The length allowed for string display.      |
'|          Separaters$     String defining word separaters.            |
'|          AutoTerminate%  Boolean statement - If true, terminates     |
'|                          LineEdit when CurPos is at end of field.    |
'|          Terminators%()  Integer Array defining exit key strokes.    |
'|                          Zeroeth element defines last terminator     |
'|                          used.  MUST BE DIMMED IN CALLING PROGRAM!   |
'|                                                                      |
'|          EditMask$       Optional string of symbols that serve to    |
'|                          mask the corresponding character in the     |
'|                          the edit string (A$).                       |
'|                                                                      |
'|              # chr(35)   digits 0-9 and any uppercase character      |
'|              A chr(65)   uppercase only (converts to upper case)     |
'|              9 chr(57)   digits 0-9 only                             |
'|              ? chr(63)   anything at all                             |
'|              8 chr(56)   digits 0-9, uppercase, "/", or space        |
'|              * chr(42)   any alpha, dash, apostraphe or space        |
'|              a chr(97)   lower case alpha only                       |
'|                                                                      |
'|  Input/Output:                                                       |
'|          A$              The string to edit - the edited string.     |
'|          CurPos%         Cursor location within the displayed string |
'|                          (use value as input to re-edit string).     |
'|          CurOffset%      Adjustment factor for left-most character   |
'|                          of the displayed string (use value as input |
'|                          to re-edit string).                         |
'|                                                                      |
'|  Output: Kee%            The exit key user hit to exit this routine. |
'|                                                                      |
'|  Note:   Extended keys, ie., up/down arrow, are returned as negative |
'|          numbers.                                                    |
'|                                                                      |
'|  Edit Functions:                                                     |
'|          Backspace       Deletes character to left of cursor         |
'|          Delete          Deletes character under cursor              |
'|          Ctrl + Home     Deletes from cursor to beginning of line    |
'|          Ctrl + End      Deletes from cursor to end of line          |
'|          Ctrl + Right    Move to word on right (skips separaters)    |
'|          Ctrl + Left     Move to word on left (skips separaters)     |
'|          Home            Move to beginning of string                 |
'|          End             Move to space after last char of string     |
'|          Right           Move cursor one character to right          |
'|          Left            Move cursor one character to left           |
'|                                                                      |
'+----------------------------------------------------------------------+
'
SUB LineEdit (Row%, Col%, CurPos%, A$, VwindowSize%, DisplayLen%, CurOffset%, Kee%, Separaters$, Terminators(), EditMask$, AutoTerminate%)

    IF VwindowSize% < DisplayLen% THEN VwindowSize% = DisplayLen%
    IF CurPos = False THEN CurPos = 1       'Set cursor position
    Escan = 7                               'Set End Scan Line

    '---- Insert is either On or Off
    InsIsOn% = InsertState%

    GOSUB DisplayLine                       'Display the string to edit
    COLOR 14, False                         'Force color change with edits

    IF LEN(EditMask$) THEN                  'If we have an edit mask...
        IF LEN(EditMask$) < VwindowSize% THEN  'and it a wee short...
            '---- Pad the edit mask with "?" (anything) symbols
            EditMask$ = EditMask$ + STRING$(VwindowSize% - LEN(EditMask$), 63)
        END IF
    END IF

    DO
        DO
            LastIns = InsIsOn               'Save the state of the Ins key
            Kee% = KeyPressed%              'Get a key from keyboard buffer

            '---- If Insert is changed then toggle the state of InsIsOn
            IF Kee = -82 THEN Kee = False: InsIsOn = InsIsOn XOR True
            IF LastIns <> InsIsOn THEN GOSUB SetLocation

            '---- Loop to the last terminator used.  Is it our keystroke?
            FOR N = 1 TO Terminators(False)
                IF Terminators(N) = Kee% THEN Terminated = True
            NEXT
        LOOP UNTIL Kee%
        IF Terminated THEN EXIT DO

        StrPos = CurPos + CurOffset           'Pointer into the string
        CharOK = True                         'Initialize this to true
        IF LEN(EditMask$) THEN
            '---- If Kee isn't an extended keystroke, backspace or enter...
            IF NOT (Kee% < False OR Kee = 8 OR Kee = 13) THEN
                MaskChar = ASC(MID$(EditMask$, StrPos, 1))  'Get mask char
                CharOK = False                              'Assume false
                IF MaskChar = 35 THEN GOSUB NumAndUpper     '# symbol
                IF MaskChar = 65 THEN GOSUB MakeUpper       'A symbol
                IF MaskChar = 57 THEN GOSUB CheckNum        '9 symbol
                IF MaskChar = 63 THEN CharOK = True         '? symbol
                IF MaskChar = 56 THEN GOSUB NumAndUpper     '8 symbol
                IF MaskChar = 42 THEN GOSUB AnyAlpha        '* symbol
                IF MaskChar = 97 THEN GOSUB MakeLower       'a symbol
            END IF
            IF NOT CharOK THEN RingSound: Kee = False
        END IF

        SELECT CASE Kee
            CASE 8                            'Backspace
                IF StrPos > 1 THEN
                    A$ = LEFT$(A$, StrPos - 2) + MID$(A$, StrPos)
                    GOSUB CursorLeft
                ELSE
                    RingSound
                END IF

            CASE 13                           'Enter key
                EXIT DO

            CASE -83                          'Delete
                IF LEN(A$) = False THEN
                    RingSound
                ELSE
                    A$ = LEFT$(A$, StrPos - 1) + MID$(A$, StrPos + 1)
                    GOSUB DisplayLine
                END IF

            CASE -71                          'Home
                IF CurPos = 1 THEN
                    RingSound
                ELSE
                    CurPos = 1
                    CurOffset = False
                    GOSUB DisplayLine
                END IF

            CASE -79                          'End
                IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN RingSound
                GOSUB LocateEnd

            CASE -77                          'Right arrow
                GOSUB CursorRight

            CASE -75                          'Left arrow
                GOSUB CursorLeft

            CASE -119                         'Ctrl + Home
                A$ = MID$(A$, StrPos + 1)
                CurPos = 1: CurOffset = False
                GOSUB DisplayLine

            CASE -115                         'Ctrl + Left arrow
                IF StrPos = 1 THEN RingSound
                StepValue = True
                GOSUB SkipRepeatingSeparaters

            CASE -116                         'Ctrl + Right arrow
                IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN
                    RingSound
                ELSE
                    StepValue = 1
                    GOSUB SkipRepeatingSeparaters
                END IF

            CASE -117                         'Ctrl + End
                IF StrPos = LEN(A$) + 1 OR StrPos = VwindowSize% THEN RingSound
                A$ = LEFT$(A$, StrPos - 1)
                GOSUB DisplayLine

            CASE ELSE
                IF Kee > 31 THEN              'Accept if space char or greater
                    IF InsIsOn% THEN
                        '---- Padding left-side of string prevents the cursor
                        '     from backing up if the cursor is on blank space
                        '     beyond the length of the string.
                        IF StrPos > LEN(A$) AND LEN(A$) < VwindowSize% THEN
                            A$ = LEFT$(A$ + STRING$(StrPos - LEN(A$), 32), StrPos - 1) + CHR$(Kee) + MID$(A$, StrPos)
                        ELSE
                            A$ = LEFT$(A$, StrPos - 1) + CHR$(Kee) + MID$(A$, StrPos)
                        END IF
                        IF LEN(A$) > VwindowSize% THEN A$ = LEFT$(A$, VwindowSize%)
                    ELSE
                        '---- Padding string prevents Illegal function error
                        '     with MID$() function.
                        IF StrPos > LEN(A$) AND LEN(A$) < VwindowSize% THEN
                            A$ = A$ + STRING$(StrPos - LEN(A$), 32)
                        END IF
                        MID$(A$, StrPos, 1) = CHR$(Kee%)
                    END IF
                    GOSUB CursorRight
                ELSEIF Kee THEN
                    RingSound                   'Invalid keystroke
                END IF
        END SELECT
    LOOP
    A$ = RTRIM$(A$)                             'Trim trailing spaces

    '---- Turn off cursor and set it to a two line cursor
    Column = Col: Visible = False: Sscan = 6
    GOSUB DisplayCursor

    EXIT SUB                                    'We done, finished, kaput

'+==================================================================+
'|                            SUB-ROUTINES                          |
'+------------------------------------------------------------------+

LocateEnd:
    CurOffset = LEN(A$) - DisplayLen + 1
    IF CurPos + CurOffset > VwindowSize% THEN CurOffset = CurOffset - 1
    IF CurOffset < False THEN CurPos = LEN(A$) + 1 ELSE CurPos = DisplayLen

    '---- If len(A$) = DisplayLen and <End> was hit then keep cursor in window
    IF CurPos + CurOffset > VwindowSize% THEN CurOffset = CurOffset - 1

    '---- If string is deleted then prevent Illegal function with DisplayLine
    IF CurOffset < False THEN CurOffset = False

    GOSUB DisplayLine
RETURN

CursorRight:
    IF CurPos < DisplayLen THEN
        CurPos = CurPos + 1               'Inc cursor pos by 1
    ELSEIF CurOffset + DisplayLen + 10 <= VwindowSize% THEN
        CurOffset = CurOffset + 10
        CurPos = CurPos - 9
    ELSEIF CurOffset + DisplayLen + 1 <= VwindowSize% THEN
        CurPos = DisplayLen - (VwindowSize% - (CurOffset + CurPos)) + 1
        CurOffset = VwindowSize% - DisplayLen
    ELSE
        '---- We must be at the end of the field so, if AutoTerminate is set
        '     then force an exit by emulating a keystroke for a down arrow.
        IF AutoTerminate THEN Kee = -80: EXIT SUB
        RingSound              'AutoTerminate is false so BEEP 'em up Scotty!
    END IF

    '---- Keep us from hanging outside of our DisplayLen
    IF CurPos + CurOffset > VwindowSize% THEN CurPos = CurPos - 1
    GOSUB DisplayLine
RETURN

CursorLeft:
    IF CurPos > 1 THEN
        CurPos = CurPos - 1
    ELSEIF CurOffset > 9 THEN
        CurOffset = CurOffset - 10
        CurPos = CurPos + 9
    ELSEIF CurOffset > False THEN
        CurPos = CurOffset + CurPos
        CurOffset = False
    ELSE
        RingSound
    END IF

DisplayLine:             'Display the string to be edited
    '---- Turn off cursor for clean display
    Column = Col: Visible = False: GOSUB DisplayCursor

    '---- Display the string
    PRINT MID$(A$ + STRING$(80, 176), 1 + CurOffset, DisplayLen);

    '---- Trim the string
    A$ = RTRIM$(A$)

SetLocation:             'Set cursor location
    IF CurPos + Col - 1 > 80 THEN CurPos = CurPos - 1 'Avoid illegal function
    Column = CurPos + Col - 1: Visible = 1

    '---- (adjust start scan)
    '     Three line cursor = Insert, full cursor = Overstrike
    IF InsIsOn THEN Sscan = 5 ELSE Sscan = False

DisplayCursor:
    LOCATE Row, Column, Visible, Sscan, Escan
RETURN

SkipRepeatingSeparaters:
    IF StrPos = 1 AND StepValue < False THEN RETURN

    '---- Look from Cursor position to start/end for a separater character
    IF StepValue < False THEN X = 1 ELSE X = LEN(A$)
    FOR N = StrPos TO X STEP StepValue

        '---- Look into A$, one character at a time - is it a seperater?
        J = INSTR(Separaters$, MID$(A$, N, 1))

        IF J THEN               'Found a separater character
            FoundSeparater = J  'Save J's value

            '---- Move our cursor to this separater position
            FOR i = StrPos TO N STEP StepValue
                IF StepValue < False THEN GOSUB CursorLeft ELSE GOSUB CursorRight
            NEXT

            EXIT FOR            'Cursor is on a separater so exit the loop
        END IF
    NEXT

    '---- If no separater found then cursor to start or end of string
    IF StepValue < False THEN
        IF J <= False THEN
            CurPos = 1
            CurOffset = False
            GOSUB DisplayLine
        END IF
    ELSE
        IF J = False THEN GOSUB LocateEnd
    END IF

    '---- If a separater was found, skip any repeating sequences of it.
    DO WHILE J                      'Loop while Separater has been found
        N = N + StepValue           'Increment or Decrement N
        IF N = False THEN EXIT DO   'Prevent error with MID$() function

        '---- Only looking for repeating sequences of FoundSeparater
        J = INSTR(MID$(Separaters$, FoundSeparater, 1), MID$(A$, N, 1))

        IF J THEN                   'If we found another seperater
            IF StepValue < False THEN GOSUB CursorLeft ELSE GOSUB CursorRight
        END IF

        IF N >= LEN(A$) THEN EXIT DO
    LOOP

    '---- Adjust if in virtual window and cursor is beyond the end of string
    IF CurPos + CurOffset >= LEN(A$) + 2 THEN
        CurPos = 1
        CurOffset = False
        GOSUB LocateEnd
    END IF
RETURN

NumAndUpper:
    GOSUB CheckNum
MakeUpper:
    IF Kee > 96 AND Kee < 123 THEN
        Kee = Upper(Kee)
        CharOK = True
    ELSEIF Kee > 64 AND Kee < 91 THEN
        CharOK = True
    END IF
    IF MaskChar = 56 THEN GOSUB SlashAndSpace     '8 symbol
RETURN

CheckNum:
    IF Kee > 47 AND Kee < 58 THEN CharOK = True
RETURN

SlashAndSpace:
    IF Kee = 47 THEN CharOK = True
Spaces:
    IF Kee = 32 THEN CharOK = True
RETURN

AnyAlpha:
    IF ((Kee > 64 AND Kee < 91) OR (Kee > 96 AND Kee < 123)) THEN CharOK = True

    '---- Apostrophe, dash, dot
    IF (Kee = 39 OR (Kee > 44 AND Kee < 47)) THEN CharOK = True
    GOSUB Spaces
RETURN

MakeLower:
    IF Kee > 64 AND Kee < 91 THEN
        Kee = Lower(Kee)
        CharOK = True
    ELSEIF Kee > 96 AND Kee < 123 THEN
        CharOK = True
    END IF
RETURN

END SUB